home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
TSR
/
TSRSRC35
/
RELNET.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-10-21
|
48KB
|
1,490 lines
{**************************************************************************
* RELNET - releases memory above the last MARKNET call made. *
* Copyright (c) 1986,1993 Kim Kokkonen, TurboPower Software. *
* May be freely distributed and used but not sold except by permission. *
***************************************************************************
* Version 2.7 3/4/89 *
* first public release *
* (based on RELEASE 2.6) *
* Version 2.8 3/10/89 *
* restore the DOS environment *
* restore the async ports *
* Version 2.9 5/4/89 *
* ignore file marks *
* Version 3.0 9/25/91 *
* make compatible with DOS 5 *
* handle NetWare IPX better, allowing release of NETBIOS TSR *
* add Quiet option *
* update for new WATCH behavior *
* restore BIOS LPT port data areas *
* restore XMS allocation *
* add code for tracking high memory *
* Version 3.1 11/4/91 *
* restore less of DOS variables table (more deactivates high memory *
* after a release) *
* add option to disable IPX socket shutdown *
* Version 3.2 11/22/91 *
* version 3.1 crashed under DOS 3.3 (RestoreDosTable) *
* change method of accessing high memory *
* reverse order in which memory blocks are released to work *
* correctly with the 386MAX high memory manager *
* merge blocks in high memory after release (QEMM doesn't) *
* Version 3.3 1/8/92 *
* add /H to use high memory optionally *
* new features for parsing and getting command line options *
* Version 3.4 2/14/92 *
* release HMA when appropriate *
* fix hang that occurs when QEMM LOADHI didn't have space to *
* load a mark high *
* Version 3.5 *
* modify RestoreEMSMap to deal with EMS blocks for which a mapping *
* context has been stored *
* accept DOS 6 *
* solve problem with RELNET /U for a MARK loaded high with QEMM 7.0 *
* solve problem with RELNET /U for a MARK loaded high with 386MAX *
* restore BIOS com port addresses at $40:$0 *
***************************************************************************
* Telephone: 719-260-6641, CompuServe: 76004,2611. *
* Requires Turbo Pascal 6 or 7 to compile. *
***************************************************************************}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 16384,0,655360}
{.$DEFINE Debug}
program RelNet;
uses
Dos,
MemU,
Ipx,
Xms,
Ems;
const
MarkFOpen : Boolean = False; {True while mark file is open}
VectorsRestored : Boolean = False; {True after old vector table restored}
var
Blocks : BlockArray;
markBlock : BlockType;
BlockMax : BlockType;
markPsp : Word;
MarkName : PathStr;
ReturnCode : Word;
StartMCB : Word;
HiMemSeg : Word;
Revector8259 : Boolean;
DealWithIpx : Boolean;
DealWithEMS : Boolean;
DealWithXMS : Boolean;
KeepMark : Boolean;
RestoreEnvir : Boolean;
ResetTimer : Boolean;
RestoreComm : Boolean;
MemMark : Boolean;
FilMark : Boolean;
Verbose : Boolean;
Quiet : Boolean;
OptUseHiMem : Boolean;
UseHiMem : Boolean;
DealWithCDs : Boolean;
Keys : string[16];
MarkEHandles : Word;
CurrEHandles : Word;
MarkEmsHandles : PageArrayPtr;
CurrEmsHandles : PageArrayPtr;
TrappedBytes : LongInt;
MarkXHandles : Word;
CurrXHandles : Word;
MarkXmsHandles : XmsHandlesPtr;
CurrXmsHandles : XmsHandlesPtr;
MarkHmaStatus : Byte;
CurHmaStatus : Byte;
{Save areas read in from file mark}
Vectors : array[0..1023] of Byte;
EGAsavTable : array[0..7] of Byte;
IntComTable : array[0..15] of Byte;
ParentSeg : Word;
ParentLen : Word;
BiosLowTable : array[0..17] of Byte;
DevA : DeviceArray; {Temporary array of device headers}
DevCnt : Word; {Number of device headers}
CommandPsp : array[1..$100] of Byte; {Buffer for COMMAND.COM PSP}
DosData : array[1..$200] of Byte; {Buffer for DOS data area}
DosTableSize : Word;
DosTable : Pointer; {Dos internal variables}
FileTableA : array[1..5] of SftRecPtr; {Points to system file table buffers}
FileTableCnt : Word; {Number of system file table blocks}
FileRecSize : Word; {Bytes in internal DOS file record}
CurDirRecSize : Word; {Bytes in internal DOS curdir record}
PatchOfst : Word; {Address of COMMAND.COM patch}
PatchSegm : Word;
EnvLen : Word; {Bytes in DOS environment}
EnvPtr : Pointer; {Pointer to copy of DOS environment}
PicMask : Byte; {8259 interrupt mask}
ComData : ComArray; {Communications data array}
McbG : McbGroup; {Allocated Mcbs}
TestPtr : DeviceHeaderPtr; {Test pointer while getting started on chain}
DevicePtr : DeviceHeaderPtr; {Pointer to the next device header}
DeviceSegment : Word; {Current device segment}
DeviceOffset : Word; {Current device offset}
MarkF : file; {Saved system information file}
DosPtr : ^DosRec; {Pointer to internal DOS variable table}
CommandSeg : Word; {Segment of low memory COMMAND.COM}
TmpCommandSeg : Word; {Segment of COMMAND.COM returned by FindTheBlocks}
CDCnt : Word; {For tracking MSCDEX information}
CDInfo : CDROMDeviceArray;
procedure NoRestoreHalt(ReturnCode : Word);
{-Replace Turbo halt with one that doesn't restore any interrupts}
begin
if VectorsRestored then begin
Close(Output);
asm
mov ah,$4C
mov al,byte(ReturnCode)
int $21
end;
end else
System.Halt(ReturnCode);
end;
procedure RemoveMarkFile;
{-Close and remove the mark file}
begin
Close(MarkF);
if IoResult = 0 then
if not KeepMark then begin
Erase(MarkF);
if IoResult = 0 then ;
end;
MarkFOpen := False;
end;
procedure Abort(Msg : String);
{-Halt in case of error}
begin
if MarkFOpen then
RemoveMarkFile;
WriteLn(Msg);
Halt(255);
end;
function FindMark(MarkName, MarkID : String;
MarkOffset : Word;
var MemMark, FilMark : Boolean;
var B : BlockType) : Boolean;
{-Find the last memory block matching idstring at offset idoffset}
var
BPsp : Word;
function HasIDstring(Segment : Word;
IdString : String;
IdOffset : Word) : Boolean;
{-Return true if idstring is found at segment:idoffset}
var
Tstring : String;
Len : Byte;
begin
Len := Length(IdString);
Tstring[0] := Chr(Len);
Move(Mem[Segment:IdOffset], Tstring[1], Len);
HasIDstring := (Tstring = IdString);
end;
function GetMarkName(Segment : Word) : String;
{-Return a cleaned up mark name from the segment's PSP}
var
Tstring : String;
Tlen : Byte absolute Tstring;
begin
Move(Mem[Segment:$80], Tstring[0], 128);
while (Tlen > 0) and ((Tstring[1] = ' ') or (Tstring[1] = ^I)) do
Delete(Tstring, 1, 1);
while (Tlen > 0) and ((Tstring[Tlen] = ' ') or (Tstring[Tlen] = ^I)) do
Dec(Tlen);
GetMarkName := StUpcase(Tstring);
end;
function MatchMemMark(Segment : Word;
MarkName : String;
var B : BlockType) : Boolean;
{-Return true if MemMark is unnamed or matches current name}
var
FoundIt : Boolean;
Tstring : String;
begin
{Check the mark name stored in the PSP of the mark block}
Tstring := GetMarkName(Segment);
FoundIt := (Tstring = MarkName);
if not FoundIt then begin
if (Tstring <> '') and (Tstring[1] = ProtectChar) then
{Current mark is protected, stop searching}
B := 1;
Dec(B);
end;
MatchMemMark := FoundIt;
end;
function MatchFilMark(Segment : Word;
MarkName : String;
var B : BlockType) : Boolean;
{-Return true if FilMark is unnamed or matches current name}
var
FoundIt : Boolean;
begin
{Check the mark name stored in the PSP of the mark block}
FoundIt := (GetMarkName(Segment) = MarkName);
if FoundIt then begin
{Assure named file exists}
if Verbose then
WriteLn('Finding mark file ', MarkName);
FoundIt := ExistFile(MarkName);
end;
if not FoundIt then
{Net marks are protected marks; stop checking if non-match found}
B := 0;
MatchFilMark := FoundIt;
end;
function MatchExactFilMark(Segment : Word;
MarkName : String;
var B : BlockType) : Boolean;
{-Return true if FilMark matches current name}
var
FoundIt : Boolean;
begin
{Check the mark name stored in the PSP of the mark block}
FoundIt := (GetMarkName(Segment) = MarkName);
if FoundIt then begin
{Assure named file exists}
if Verbose then
WriteLn('Finding mark file ', MarkName);
FoundIt := ExistFile(MarkName);
end;
if not FoundIt then
dec(B);
MatchExactFilMark := FoundIt;
end;
begin
B := BlockMax;
MemMark := False;
FilMark := False;
if UseHiMem then begin
{Scan for an exact match to the specified net mark}
repeat
BPsp := Blocks[B].Psp;
if (Blocks[B].Mcb+1 <> BPsp) or (BPsp = PrefixSeg) then
{Don't match any non-program block or this program}
Dec(B)
else if HasIDstring(BPsp, NmarkID, NmarkOffset) then
{A net mark}
FilMark := MatchExactFilMark(BPsp, MarkName, B)
else
{Not a net mark}
Dec(B);
until (B < 1) or FilMark;
end else begin
{Scan from the last block down to find the last MARK TSR}
repeat
BPsp := Blocks[B].Psp;
if (Blocks[B].Mcb+1 <> BPsp) or (BPsp = PrefixSeg) then
{Don't match any non-program block or this program}
Dec(B)
else if HasIDstring(BPsp, MarkID, MarkOffset) then
{An in-memory mark}
MemMark := MatchMemMark(BPsp, MarkName, B)
else if HasIDstring(BPsp, NmarkID, NmarkOffset) then
{A net mark}
FilMark := MatchFilMark(BPsp, MarkName, B)
else
{Ignore normal file marks}
{Not a mark}
Dec(B);
until (B < 1) or MemMark or FilMark;
end;
FindMark := MemMark or FilMark;
end;
procedure CheckReadError;
{-Check previous I/O operation}
begin
if IoResult = 0 then
Exit;
Abort('Error reading '+MarkName);
end;
function PhysicalAddress(P : Pointer) : LongInt;
begin
PhysicalAddress := LongInt(OS(P).S) shl 4+OS(P).O;
end;
procedure ValidateMarkFile;
{-Open mark file and assure it's valid}
type
IDArray = array[1..4] of Char;
var
ID : IDArray;
ExpectedID : IDArray;
begin
Assign(MarkF, MarkName);
Reset(MarkF, 1);
if IoResult <> 0 then
Abort('Mark file '+MarkName+' not found');
MarkFOpen := True;
{Check the ID at the start of the file}
ExpectedID := NetMarkID;
BlockRead(MarkF, ID, SizeOf(IDArray));
CheckReadError;
if ID <> ExpectedID then
Abort(MarkName+' is not a valid net mark file');
{Read the NUL device address}
BlockRead(MarkF, TestPtr, SizeOf(Pointer));
CheckReadError;
if PhysicalAddress(TestPtr) <> PhysicalAddress(DevicePtr) then begin
if Verbose then
WriteLn('Old NUL addr:', HexPtr(TestPtr),
' Current NUL addr:', HexPtr(DevicePtr));
Abort('Unexpected error. NUL device moved');
end;
end;
procedure BufferFileTable;
{-Read the file table from the mark file into memory}
type
SftRecStub =
record
Next : SftRecPtr;
Count : Word;
end;
var
I : Word;
Size : Word;
P : Pointer;
S : SftRecStub;
begin
BlockRead(MarkF, FileTableCnt, SizeOf(Word));
for I := 1 to FileTableCnt do begin
BlockRead(MarkF, S, SizeOf(SftRecStub));
Size := 6+S.Count*FileRecSize;
GetMem(FileTableA[I], Size);
P := FileTableA[I];
Move(S, P^, SizeOf(SftRecStub));
Inc(OS(P).O, SizeOf(SftRecStub));
BlockRead(MarkF, P^, Size-SizeOf(SftRecStub));
end;
CheckReadError;
end;
procedure ReadReg(var B : Byte);
{-Read a communications register from the mark file}
begin
BlockRead(MarkF, B, SizeOf(Byte));
CheckReadError;
end;
procedure ReadMarkFile;
{-Read the mark file info into memory}
var
DevPtr : DeviceHeaderPtr;
Com : Byte;
begin
{Read the vector table from the mark file, into a temporary memory area}
BlockRead(MarkF, Vectors, 1024);
CheckReadError;
{Read the BIOS miscellaneous save areas into temporary tables}
BlockRead(MarkF, EGAsavTable, 8);
BlockRead(MarkF, IntComTable, 16);
BlockRead(MarkF, ParentSeg, 2);
BlockRead(MarkF, ParentLen, 2);
BlockRead(MarkF, BiosLowTable, 18);
CheckReadError;
{Read the stored EMS handles, if any}
BlockRead(MarkF, MarkEHandles, SizeOf(Word));
GetMem(MarkEmsHandles, SizeOf(HandlePageRecord)*MarkEHandles);
BlockRead(MarkF, MarkEmsHandles^, SizeOf(HandlePageRecord)*MarkEHandles);
CheckReadError;
{Read the stored XMS info, if any}
BlockRead(MarkF, MarkXHandles, SizeOf(Word));
GetMem(MarkXmsHandles, SizeOf(XmsHandleRecord)*MarkXHandles);
BlockRead(MarkF, MarkXmsHandles^, SizeOf(XmsHandleRecord)*MarkXHandles);
BlockRead(MarkF, MarkHmaStatus, SizeOf(Byte));
CheckReadError;
{Read the device driver chain}
DevPtr := DevicePtr;
DevCnt := 0;
while OS(DevPtr).O <> $FFFF do begin
Inc(DevCnt);
GetMem(DevA[DevCnt], SizeOf(DeviceHeader));
BlockRead(MarkF, DevA[DevCnt]^, SizeOf(DeviceHeader));
CheckReadError;
with DevA[DevCnt]^ do
DevPtr := Ptr(NextHeaderSegment, NextHeaderOffset);
end;
{Read the DOS data area table}
BlockRead(MarkF, DosData, $200);
CheckReadError;
{Read the DOS internal variables table}
BlockRead(MarkF, DosTableSize, SizeOf(Word));
if DosTableSize <> 0 then begin
GetMem(DosTable, DosTableSize);
BlockRead(MarkF, DosTable^, DosTableSize);
end;
CheckReadError;
{Read the internal file table}
BufferFileTable;
{Read in the copy of COMMAND.COM's PSP}
BlockRead(MarkF, CommandPsp, $100);
CheckReadError;
{Read in the address used for COMMAND.COM patching by NetWare}
BlockRead(MarkF, PatchOfst, SizeOf(Word));
BlockRead(MarkF, PatchSegm, SizeOf(Word));
CheckReadError;
{Read in the DOS master environment}
BlockRead(MarkF, EnvLen, SizeOf(Word));
GetMem(EnvPtr, EnvLen);
BlockRead(MarkF, EnvPtr^, EnvLen);
CheckReadError;
{Read in the communications data area}
BlockRead(MarkF, PicMask, SizeOf(Byte));
CheckReadError;
for Com := 1 to 2 do
with ComData[Com] do begin
BlockRead(MarkF, Base, SizeOf(Word));
CheckReadError;
if Base <> 0 then begin
ReadReg(IERReg);
ReadReg(LCRReg);
ReadReg(MCRReg);
ReadReg(BRLReg);
ReadReg(BRHreg);
end;
end;
{Read in the CD-ROM info}
BlockRead(MarkF, CDCnt, SizeOf(Word));
if CDCnt <> 0 then
BlockRead(MarkF, CDInfo, CDCnt*SizeOf(CDROMDeviceRec));
CheckReadError;
{Read in the allocated Mcb chain}
BlockRead(MarkF, McbG.Count, SizeOf(Word));
BlockRead(MarkF, McbG.Mcbs, 2*SizeOf(Word)*McbG.Count);
CheckReadError;
{Close and possibly erase mark file}
RemoveMarkFile;
end;
procedure RestoreCommState;
{-Restore the communications chips to their previous state}
var
Com : Byte;
begin
for Com := 1 to 2 do
with ComData[Com] do
if Base <> 0 then begin
Port[Base+IER] := IERReg; {Interrupt enable register}
NullJump;
Port[Base+MCR] := MCRReg; {Modem control register}
NullJump;
Port[Base+LCR] := LCRReg or $80; {Enable baud rate divisor registers}
NullJump;
Port[Base+BRL] := BRLReg; {Baud rate low}
NullJump;
Port[Base+BRH] := BRHReg; {Baud rate high}
NullJump;
Port[Base+LCR] := LCRReg; {Line control register}
NullJump;
end;
{Restore the interrupt mask}
Port[$21] := PicMask;
end;
procedure CopyVectors;
{-Put interrupt vectors back into table}
procedure Reset8259;
{-Reset the 8259 interrupt controller to its powerup state}
{-Interrupts assumed OFF prior to calling this routine}
function ATmachine : Boolean;
{-Return true if machine is AT class}
var
MachType : Byte absolute $FFFF : $000E;
begin
case MachType of
$F8, $FC : ATmachine := True;
else
ATmachine := False;
end;
end;
procedure Reset8259PC;
{-Reset the 8259 on a PC class machine}
begin
inline(
$E4/$21/ { in al,$21}
$88/$C4/ { mov ah,al}
$B0/$13/ { mov al,$13}
$E6/$20/ { out $20,al}
$B0/$08/ { mov al,8}
$E6/$21/ { out $21,al}
$B0/$09/ { mov al,9}
$E6/$21/ { out $21,al}
$88/$E0/ { mov al,ah}
$E6/$21 { out $21,al}
);
end;
procedure Reset8259AT;
{-Reset the 8259 interrupt controllers on an AT machine}
begin
inline(
$32/$C0/ { xor al,al }
$E6/$F1/ { out 0f1h,al ; Switch off an 80287 if necessary}
{Set up master 8259 }
$E4/$21/ { in al,21h ; Get current interrupt mask }
$8A/$E0/ { mov ah,al ; save it }
$B0/$11/ { mov al,11h }
$E6/$20/ { out 20h,al }
$EB/$00/ { jmp short $+2 }
$B0/$08/ { mov al,8 ; Set up main interrupt vector number}
$E6/$21/ { out 21h,al }
$EB/$00/ { jmp short $+2 }
$B0/$04/ { mov al,4 }
$E6/$21/ { out 21h,al }
$EB/$00/ { jmp short $+2 }
$B0/$01/ { mov al,1 }
$E6/$21/ { out 21h,al }
$EB/$00/ { jmp short $+2 }
$8A/$C4/ { mov al,ah }
$E6/$21/ { out 21h,al }
{Set up slave 8259 }
$E4/$A1/ { in al,0a1h ; Get current interrupt mask }
$8A/$E0/ { mov ah,al ; save it }
$B0/$11/ { mov al,11h }
$E6/$A0/ { out 0a0h,al }
$EB/$00/ { jmp short $+2 }
$B0/$70/ { mov al,70h }
$E6/$A1/ { out 0a1h,al }
$B0/$02/ { mov al,2 }
$EB/$00/ { jmp short $+2 }
$E6/$A1/ { out 0a1h,al }
$EB/$00/ { jmp short $+2 }
$B0/$01/ { mov al,1 }
$E6/$A1/ { out 0a1h,al }
$EB/$00/ { jmp short $+2 }
$8A/$C4/ { mov al,ah ; Reset previous interrupt state }
$E6/$A1 { out 0a1h,al }
);
end;
begin
if ATmachine then
Reset8259AT
else
Reset8259PC;
end;
begin
{Interrupts off}
IntsOff;
{Reset 8259 if requested}
if Revector8259 then
Reset8259;
{Reset the communications state if requested}
if RestoreComm then
RestoreCommState;
{Restore the main interrupt vector table}
Move(Vectors, Mem[0:0], 1024);
{Interrupts on}
IntsOn;
{Flag that we don't want system restoring vectors for us}
VectorsRestored := True;
Move(EGAsavTable, Mem[$40:$A8], 8); {EGA table}
Move(IntComTable, Mem[$40:$F0], 16); {Interapplications communication area}
{$IFDEF Debug}
writeln('Parent address: ', HexW(ParentSeg), ' Length: ', ParentLen);
{$ENDIF}
if ValidPsp(HiMemSeg, ParentSeg, ParentLen) then begin
{Don't restore parent if it no longer exists (applies to QEMM LOADHI)}
MemW[PrefixSeg:$16] := ParentSeg;
if not UseHiMem then
{Programs loaded into high memory have strange termination addresses}
Move(Mem[0:4*$22], Mem[PrefixSeg:$0A], 4); {Int 22 addresses}
end;
Move(BiosLowTable, Mem[$40:$0], 18); {BIOS Com, Printer, Equip flag}
Move(Mem[0:4*$23], Mem[PrefixSeg:$0E], 8); {Int 23,24 addresses}
end;
procedure MarkBlocks(markBlock : BlockType);
{-Mark those blocks to be released}
var
db : BlockType;
procedure BatchWarning(B : BlockType);
{-Warn about the trapping effect of batch files}
var
T : BlockType;
begin
ReturnCode := 1;
{Accumulate number of bytes temporarily trapped}
for T := 1 to B do
if Blocks[T].ReleaseIt then
Inc(TrappedBytes, LongInt(MemW[Blocks[T].Mcb:3]) shl 4);
end;
procedure MarkBlocksAbove;
{-Mark blocks above the mark}
var
b : BlockType;
begin
for b := 1 to BlockMax do
with Blocks[b] do
if (b >= markBlock) and (mcb+1 = psp) and (memw[psp:$16] = psp) then begin
{Don't release blocks owned by master COMMAND.COM}
releaseIt := False;
BatchWarning(b);
end else if KeepMark then
{Release all but RELEASE and the mark}
releaseIt := (psp <> PrefixSeg) and (psp > markPsp)
else
releaseIt := (psp <> PrefixSeg) and (psp >= markPsp);
end;
procedure MarkUnallocatedBlocks;
{-Mark blocks that weren't allocated at time of mark}
var
TopSeg : Word;
b : BlockType;
m : BlockType;
Found : Boolean;
begin
{Find last low memory mcb}
TopSeg := TopOfMemSeg-1;
m := 1;
Found := False;
while (not Found) and (m <= McbG.Count) do
if McbG.Mcbs[m].mcb >= TopSeg then
Found := True
else
inc(m);
{Mark out all mcbs associated with psp of last low memory mcb}
TopSeg := McbG.Mcbs[m-1].psp;
if TopSeg <> markPsp then
for m := 1 to McbG.Count do
with McbG.Mcbs[m] do
if psp = TopSeg then
psp := 0;
for b := 1 to BlockMax do
with Blocks[b] do begin
Found := False;
m := 1;
while (not Found) and (m <= McbG.Count) do begin
Found := (McbG.Mcbs[m].psp <> 0) and (McbG.Mcbs[m].mcb = mcb);
inc(m);
end;
if Found then
{was allocated at time of mark, keep it now unless a mark to be released}
releaseIt := not KeepMark and (psp = markPsp)
else if (mcb+1 = psp) and (memw[psp:$16] = psp) then
{Don't release blocks owned by master COMMAND.COM}
releaseIt := False
else if (psp <= $400) or (psp >= $FFF0) then
{Don't release blocks owned by system or 386MAX}
releaseIt := False
else
{not allocated at time of mark}
releaseIt := (psp <> PrefixSeg);
end;
end;
begin
if UseHiMem then
MarkUnallocatedBlocks
else
MarkBlocksAbove;
{$IFDEF Debug}
for db := 1 to BlockMax do
with Blocks[db] do
if releaseIt then
WriteLn(db:3, ' ', HexW(psp), ' ', HexW(mcb), ' ', releaseIt);
ReadLn;
{$ENDIF}
end;
function ReleaseBlock(Segm : Word) : Word; assembler;
{-Use DOS services to release memory block}
asm
mov ah,$49
mov es,Segm
int $21
jc @Done
xor ax,ax
@Done:
end;
procedure ReleaseMem;
{-Release DOS memory marked for release}
var
b : BlockType;
begin
if Verbose then begin
WriteLn('Releasing DOS memory');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
for b := BlockMax downto 1 do
with blocks[b] do
if releaseIt then begin
{$IFDEF Debug}
WriteLn(' ', hexw(mcb), ' ', hexw(psp));
{$ENDIF}
if ReleaseBlock(mcb+1) <> 0 then begin
WriteLn('Could not release block at segment ', HexW(mcb+1));
Abort('Memory may be a mess... Please reboot');
end;
end;
if Verbose then begin
WriteLn('Merging free blocks in high memory');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
MergeHiMemBlocks(HiMemSeg);
end;
procedure RestoreEMSmap;
{-Restore EMS to state at time of mark}
var
O, N, NHandle : Word;
procedure EmsError;
begin
WriteLn('Program error or EMS device not responding');
Abort('EMS memory may be a mess... Please reboot');
end;
procedure MapAndFree(Handle : Word);
var
Status : Byte;
begin
Status := FreeEms(NHandle);
if Status = $86 then
Status := RestorePageMap(NHandle);
if Status <> 0 then
EmsError;
end;
begin
{Get the existing EMS page map}
GetMem(CurrEmsHandles, MaxHandles*SizeOf(HandlePageRecord));
CurrEHandles := EmsHandles(CurrEmsHandles^);
if CurrEHandles > MaxHandles then
WriteLn('EMS handle count exceeds capacity of RELNET -- no action taken')
else if CurrEHandles <> 0 then begin
{See how many handles were active when MARK was installed}
if Verbose then begin
WriteLn('Releasing EMS memory allocated since MARK');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
{Compare the two maps and deallocate pages not in the stored map}
for N := 1 to CurrEHandles do begin
{Scan all current handles}
NHandle := CurrEmsHandles^[N].Handle;
if MarkEHandles > 0 then begin
{See if current handle matches one stored by MARK}
O := 1;
while (MarkEmsHandles^[O].Handle <> NHandle) and (O <= MarkEHandles) do
Inc(O);
{If not, deallocate the current handle}
if (O > MarkEHandles) then
MapAndFree(NHandle);
end else
{No handles stored by MARK, deallocate all current handles}
MapAndFree(NHandle);
end;
end;
end;
procedure RestoreXmsmap;
{-Restore Xms to state at time of mark}
var
O, N, NHandle : Word;
procedure XmsError;
begin
WriteLn('Program error or XMS device not responding');
Abort('XMS memory may be a mess... Please reboot');
end;
begin
CurrXHandles := GetXmsHandles(CurrXmsHandles);
if CurrXHandles <> 0 then begin
{See how many handles were active when MARK was installed}
if Verbose then begin
WriteLn('Releasing XMS memory allocated since MARK');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
if MarkXHandles = 0 then begin
{Release all current XMS Handles}
for N := 1 to CurrXHandles do
if FreeExtMem(CurrXmsHandles^[N].Handle) <> 0 then
XmsError;
end else begin
{Compare the two maps and deallocate pages not in the stored map}
for N := 1 to CurrXHandles do begin
{Scan all current handles}
NHandle := CurrXmsHandles^[N].Handle;
{See if current handle matches one stored by MARK}
O := 1;
while (MarkXmsHandles^[O].Handle <> NHandle) and (O <= MarkXHandles) do
Inc(O);
{If not, deallocate the current handle}
if (O > MarkXHandles) then
if FreeExtMem(NHandle) <> 0 then
XmsError;
end;
end;
end;
{Free the HMA if appropriate}
CurHmaStatus := AllocateHma($FFFF);
if (CurHMAStatus = 0) or (MarkHMAStatus = 0) then
if FreeHma = 0 then ;
end;
procedure GetOptions;
{-Analyze command line for options}
procedure WriteCopyright;
begin
WriteLn('RELNET ', Version, ', Copyright 1993 TurboPower Software');
end;
procedure WriteHelp;
{-Show the options}
begin
WriteCopyright;
WriteLn;
WriteLn('RELNET removes memory-resident programs from memory, particularly network');
WriteLn('shells like Novell''s NetWare, although it will also release normal memory');
WriteLn('resident programs. In combination with MARKNET it thoroughly restores the');
WriteLn('system to its state at the time MARKNET was called.');
WriteLn;
WriteLn('RELNET accepts the following command line syntax:');
WriteLn;
WriteLn(' RELNET NetMarkFile [Options]');
WriteLn;
WriteLn('Options may be preceded by either / or -. Valid options are:');
WriteLn;
WriteLn(' /C do NOT restore communications state.');
WriteLn(' /E do NOT access EMS memory.');
WriteLn(' /H work with upper memory if available.');
WriteLn(' /I do NOT shut down IPX events and sockets.');
WriteLn(' /K release memory, but keep the mark in place.');
WriteLn(' /L do NOT restore CD-ROM drive letters.');
WriteLn(' /P do NOT restore DOS environment.');
WriteLn(' /Q write no screen output.');
WriteLn(' /R revector 8259 interrupt controller to powerup state.');
WriteLn(' /S chars stuff string (<16 chars) into keyboard buffer on exit.');
WriteLn(' /T do NOT reset system timer chip to default rate.');
WriteLn(' /U work with upper memory, but halt if none found.');
WriteLn(' /V verbose: show each step of the restore.');
WriteLn(' /X do NOT access XMS memory.');
WriteLn(' /? write this help screen.');
Halt(1);
end;
procedure GetArgs(S : String);
var
SPos : Word;
Arg : String[127];
begin
SPos := 1;
repeat
Arg := NextArg(S, SPos);
if Arg = '' then
Exit;
if Arg[1] = '?' then
WriteHelp
else if (Arg[1] = '-') or (Arg[1] = '/') then
case Length(Arg) of
1 : Abort('Missing command option following '+Arg);
2 : case Upcase(Arg[2]) of
'C' : RestoreComm := False;
'E' : DealWithEMS := False;
'H' : OptUseHiMem := True;
'I' : DealWithIPX := False;
'K' : KeepMark := True;
'L' : DealWithCDs := False;
'P' : RestoreEnvir := False;
'Q' : Quiet := True;
'R' : Revector8259 := True;
'S' : begin
Arg := NextArg(S, SPos);
if Length(Arg) = 0 then
Abort('Key string missing');
if Length(Arg) > 15 then
Abort('No more than 15 keys may be stuffed');
Keys := Arg+^M;
end;
'T' : ResetTimer := False;
'U' : UseHiMem := True;
'V' : Verbose := True;
'X' : DealWithXMS := False;
'?' : WriteHelp;
else
Abort('Unknown command option: '+Arg);
end;
else
Abort('Unknown command option: '+Arg);
end
else if Length(MarkName) = 0 then
{Mark file}
MarkName := StUpcase(Arg)
else
Abort('Too many mark files specified');
until False;
end;
begin
{Initialize defaults}
MarkName := '';
Keys := '';
Revector8259 := False;
KeepMark := False;
DealWithIPX := True;
DealWithEMS := True;
DealWithXMS := True;
ResetTimer := True;
Verbose := False;
Quiet := False;
RestoreEnvir := True;
RestoreComm := True;
UseHiMem := False;
OptUseHiMem := False;
DealWithCDs := True;
ReturnCode := 0;
TrappedBytes := 00;
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('RELNET'));
if Length(MarkName) = 0 then begin
WriteLn('No mark file specified');
WriteHelp;
end;
if Verbose then
Quiet := False;
if not Quiet then
WriteCopyright;
{Initialize for high memory access}
if OptUseHiMem or UseHiMem then begin
HiMemSeg := FindHiMemStart;
if HiMemSeg = 0 then begin
if UseHiMem then
Abort('No upper memory blocks found');
end else
UseHiMem := True;
end else
HiMemSeg := 0;
end;
function MemoryRelease(P : Pointer) : Boolean;
{-Return True if address P is in a block to be released}
var
B : BlockType;
PL : LongInt;
PSPL : LongInt;
begin
PL := PhysicalAddress(P);
for B := 1 to BlockMax do
with Blocks[B] do
if ReleaseIt then begin
PSPL := LongInt(Psp) shl 4;
if (PL >= PSPL) and (PL < PSPL+LongInt(MemW[Mcb:3]) shl 4) then begin
MemoryRelease := True;
Exit;
end;
end;
MemoryRelease := False;
end;
procedure CloseIpxSockets;
const
Retf : Byte = $CB; {Return instruction}
var
This, Next : IpxEcbPtr;
Ecb : IpxEcb;
Status : Byte;
begin
{Create a new Ecb to find start of linked list of Ecb's}
FillChar(Ecb, SizeOf(IpxEcb), 0);
Ecb.EsrAddress := @RetF;
ScheduleSpecialEvent(182, Ecb);
{Scan the list of Ecb's}
This := Ecb.Link;
while This <> nil do begin
if Verbose then
Write('Ecb: ', HexPtr(This),
' Esr: ', HexPtr(This^.EsrAddress),
' InUse: ', HexW(This^.InUse),
' Socket: ', HexW(This^.SocketNumber));
Next := This^.Link;
if MemoryRelease(This) or MemoryRelease(This^.ESRAddress) then
{Memory of this Ecb will be released}
if This^.InUse <> 0 then begin
{This Ecb is in use}
Status := CancelEvent(This^);
if Verbose then
Write(' [cancelled]');
if This^.SocketNumber <> 0 then begin
CloseSocket(This^.SocketNumber);
if Verbose then
Write(' [closed]');
end;
end;
if Verbose then
Writeln;
This := Next;
end;
{Cancel the special event we started}
Status := CancelEvent(Ecb);
end;
procedure FindDevChain;
{-Return segment, offset and pointer to NUL device}
begin
DosPtr := Ptr(OS(DosList).S, OS(DosList).O-2);
DevicePtr := @DosPtr^.NullDevice;
DeviceSegment := OS(DevicePtr).S;
DeviceOffset := OS(DevicePtr).O;
end;
procedure RestoreDosTable;
{-Restore the DOS variables table, except for the buffer pointer}
type
ByteArray = array[0..32767] of Byte;
ByteArrayPtr = ^ByteArray;
var
DosBase : Pointer;
SPtr : Pointer;
DPtr : Pointer;
begin
if Verbose then begin
WriteLn('Restoring DOS data area at 0050:0000');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
DPtr := Ptr($50, 0);
Move(DosData, DPtr^, $200);
DosBase := Ptr(OS(DosPtr).S, 0);
if Verbose then begin
WriteLn('Restoring ', DosTableSize,
' bytes of DOS variables table at ', HexPtr(DosBase));
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
{patch up DosTable to reflect current items that must be maintained}
{CachePtr}
SPtr := @DosPtr^.CachePtr;
DPtr := @ByteArrayPtr(DosTable)^[Ofs(DosPtr^.CachePtr)];
{$IFDEF Debug}
writeln('cacheptr ', hexptr(sptr), '->', hexptr(dptr), ' ', SizeOf(Pointer));
{$ENDIF}
move(SPtr^, DPtr^, SizeOf(Pointer));
if DosV = 5 then begin
{Other unknown areas}
SPtr := Ptr(OS(DosPtr).S, OS(DosPtr).O+SizeOf(DosRec));
DPtr := @ByteArrayPtr(DosTable)^[OS(DosPtr).O+SizeOf(DosRec)];
{$IFDEF Debug}
writeln('unknown ', hexptr(sptr), '->', hexptr(dptr), ' ',
OS(DosPtr^.FirstSFT).O-OS(DosPtr).O-SizeOf(DosRec)-$3C);
{$ENDIF}
move(SPtr^, DPtr^, OS(DosPtr^.FirstSFT).O-OS(DosPtr).O-SizeOf(DosRec)-$3C);
end;
{Restore DOS table}
move(DosTable^, DosBase^, DosTableSize);
end;
procedure RestoreFileTable;
{-Copy the internal file table from our memory buffer to its DOS location}
var
S : SftRecPtr;
I : Word;
begin
S := DosPtr^.FirstSFT;
if Verbose then begin
WriteLn('Restoring DOS file table at ', HexPtr(S));
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
for I := 1 to FileTableCnt do begin
Move(FileTableA[I]^, S^, 6+FileTableA[I]^.Count*FileRecSize);
S := S^.Next;
end;
end;
procedure RestoreDeviceDrivers;
{-Restore the device driver chain to its original state}
var
D : Word;
DevPtr : DeviceHeaderPtr;
begin
if Verbose then begin
WriteLn('Restoring device driver chain');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
DevPtr := DevicePtr;
for D := 1 to DevCnt do begin
DevPtr^ := DevA[D]^;
with DevA[D]^ do
DevPtr := Ptr(NextHeaderSegment, NextHeaderOffset);
end;
end;
procedure RestoreCommandPSP;
{-Copy COMMAND.COM's PSP back into place}
var
PspPtr : Pointer;
begin
PspPtr := Ptr(CommandSeg, 0);
if Verbose then begin
WriteLn('Restoring COMMAND.COM PSP at ', HexPtr(PspPtr));
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
Move(CommandPsp, PspPtr^, $100);
end;
procedure RestoreCommandPatch;
{-Restore the patch that NetWare applies to COMMAND.COM}
begin
if (PatchSegm <> 0) or (PatchOfst <> 0) then
if (Mem[PatchSegm:PatchOfst+$01] <> Byte('/')) or
(Mem[PatchSegm:PatchOfst+$11] <> Byte('/')) then begin
if Verbose then begin
WriteLn('Removing patch at ', HexW(PatchSegm), ':', HexW(PatchOfst));
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
Mem[PatchSegm:PatchOfst+$01] := Byte('/');
Mem[PatchSegm:PatchOfst+$11] := Byte('/');
end;
end;
procedure FindEnv(CommandSeg : Word; var EnvSeg, EnvLen : Word);
{-Return the segment and length of the master environment}
var
Mcb : Word;
begin
Mcb := CommandSeg-1;
EnvSeg := MemW[CommandSeg:$2C];
if EnvSeg = 0 then
{Master environment is next block past COMMAND}
EnvSeg := Commandseg+MemW[Mcb:3]+1;
EnvLen := MemW[(EnvSeg-1):3] shl 4;
end;
procedure RestoreDosEnvironment;
{-Restore the master copy of the DOS environment}
var
EnvSeg : Word;
CurLen : Word;
P : Pointer;
begin
if RestoreEnvir then begin
FindEnv(CommandSeg, EnvSeg, CurLen);
if CurLen <> EnvLen then
Abort('Environment length changed');
if Verbose then begin
WriteLn('Restoring DOS environment, ', EnvLen, ' bytes at ', HexW(EnvSeg), ':0000');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
P := Ptr(EnvSeg, 0);
move(EnvPtr^, P^, EnvLen);
end;
end;
procedure SetTimerRate(Rate : Word);
{-Program system 8253 timer number 0 to run at specified rate}
begin
IntsOff;
Port[$43] := $36;
NullJump;
Port[$40] := Lo(Rate);
NullJump;
Port[$40] := Hi(Rate);
IntsOn;
end;
procedure RestoreTimer;
{-Set the system timer to its normal rate}
begin
if Verbose then begin
WriteLn('Restoring system timer to normal rate');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
SetTimerRate(0);
end;
procedure RestoreCDROMs;
{-Restore drive letters used by MSCDEX}
var
CurCDCnt : Word;
I : Word;
J : Word;
CDP : CurDirRecPtr;
Found : Boolean;
DLet : Char;
CurCDInfo : CDROMDeviceArray;
begin
if not DealWithCDs then
exit;
if Verbose then begin
Write('Restoring CD-ROM device letters');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
CurCDCnt := GetCDCount(CurCDInfo);
if CurCDCnt > CDCnt then
{MSCDEX is being unloaded}
for I := 1 to CurCDCnt do begin
{Is current CD in the original CD list?}
Found := False;
J := 1;
while not(Found) and (J <= CDCnt) do
if (CurCDInfo[I].SubUnit = CDInfo[J].SubUnit) and
(CurCDInfo[I].Header = CDInfo[J].Header) and
(CurCDInfo[I].Header^.DriveLet = CDInfo[J].Header^.DriveLet) then
Found := True
else
inc(J);
if not(Found) then begin
DLet := Char(Byte('A')+CurCDInfo[I].Header^.DriveLet-1);
if DLet >= 'A' then begin
if Verbose then
Write(' ', DLet);
{Clear DOS CurDir record for this drive}
CDP := DosPtr^.CurDirTable;
inc(LongInt(CDP), (Byte(DLet)-Byte('A'))*CurDirRecSize);
with CDP^ do begin
{Restore default path and installable file system info}
DrivePath[0] := DLet;
DrivePath[1] := ':';
DrivePath[2] := '\';
DrivePath[3] := #0;
Flags := 0;
DPB := nil;
RedirIfs := Ptr($FFFF, $FFFF);
Param := $FFFF;
BackSlashOfs := 2;
end;
{Clear drive letter for this header}
CurCDInfo[I].Header^.DriveLet := 0;
end;
end;
end;
if Verbose then
WriteLn;
end;
function CompaqDOS30 : Boolean; assembler;
{-Return true if Compaq DOS 3.0}
asm
mov ah,$34
int $21
cmp bx,$019C
mov al,1
jz @Done
dec al
@Done:
end;
procedure ValidateDosVersion;
{-Assure supported version of DOS and compute size of DOS internal filerec}
var
DosVer : Word;
begin
DosVer := DosVersion;
CurDirRecSize := 81;
case Hi(DosVer) of
3 : if (Hi(DosVer) < $0A) and not CompaqDOS30 then
{IBM DOS 3.0}
FileRecSize := 56
else
{DOS 3.1+ or Compaq DOS 3.0}
FileRecSize := 53;
4, 5, 6 :
begin
FileRecSize := 59;
CurDirRecSize := 88;
end;
else
Abort('Requires DOS 3 - 6');
end;
end;
begin
{Assure supported version of DOS}
ValidateDosVersion;
{Analyze command line for options}
GetOptions;
{Find the start of the device driver chain via the NUL device}
FindDevChain;
{Get all allocated memory blocks in normal memory}
FindTheBlocks(True, HiMemSeg, Blocks, BlockMax, StartMcb);
CommandSeg := MasterCommandSeg(HiMemSeg);
{Find the block marked with the MARK idstring, and MarkName if specified}
if not(FindMark(MarkName, MarkID, MarkOffset, MemMark, FilMark, markBlock)) then
Abort('No matching marker found, or protected marker encountered.');
if MemMark then
Abort('Marker must have been placed by MARKNET');
markPsp := Blocks[markBlock].psp;
{Open and validate the mark file}
ValidateMarkFile;
{Close IPX sockets and cancel IPX ECBs}
if DealWithIpx then
if IpxInstalled then
CloseIpxSockets;
{Get file mark information into memory}
ReadMarkFile;
{Restore the CD-ROM drive letters}
RestoreCDROMs;
{Mark those blocks to be released}
MarkBlocks(markBlock);
{Copy the vector table from the MARK copy}
CopyVectors;
{Restore the device driver chain}
RestoreDeviceDrivers;
{Restore the COMMAND.COM patch possibly made by NetWare}
RestoreCommandPatch;
{Restore the DOS variables table}
RestoreDosTable;
{Restore the DOS file table}
RestoreFileTable;
{Restore the COMMAND.COM PSP}
RestoreCommandPSP;
{Restore the master DOS environment}
RestoreDosEnvironment;
{Set the timer to normal rate}
if ResetTimer then
RestoreTimer;
(*
this isn't necessary, and in fact is harmful, when the DOS file table
is being restored above.
{Close open file handles}
CloseHandles;
*)
{Release normal memory}
ReleaseMem;
{Deal with expanded memory}
if DealWithEMS then
if EMSpresent then
RestoreEMSmap;
{Deal with extended memory}
if DealWithXMS then
if XMSInstalled then
RestoreXMSMap;
{Write success message}
if not Quiet then
WriteLn('Memory released after ', StUpcase(MarkName));
if (ReturnCode <> 0) and Verbose then
WriteLn(TrappedBytes, ' bytes temporarily trapped until batch file completes');
{Stuff keyboard buffer if requested}
if Length(Keys) > 0 then
StuffKeys(Keys, True);
NoRestoreHalt(ReturnCode);
end.